home *** CD-ROM | disk | FTP | other *** search
/ Action Arcade 1997 / Action Arcade 1997.iso / ps / unit1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-12-17  |  3.8 KB  |  155 lines
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ExtCtrls, StdCtrls, FileCtrl,FmxUtils, Gauges, DdeMan, Buttons;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Panel1: TPanel;
  12.     ComboBox1: TComboBox;
  13.     Image2: TImage;
  14.     Image1: TImage;
  15.     RCD: TImage;
  16.     Image3: TImage;
  17.     Image4: TImage;
  18.     Label1: TLabel;
  19.     Label2: TLabel;
  20.     Label3: TLabel;
  21.     ScrollBox1: TScrollBox;
  22.     Image5: TImage;
  23.     Label4: TLabel;
  24.     Label5: TLabel;
  25.     Label6: TLabel;
  26.     flb1: TFileListBox;
  27.     flb2: TFileListBox;
  28.     flb3: TFileListBox;
  29.     DdeClient: TDdeClientConv;
  30.     ben: TGauge;
  31.     dr: TComboBox;
  32.     BitBtn1: TBitBtn;
  33.     procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
  34.       Shift: TShiftState; X, Y: Integer);
  35.     procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
  36.       Shift: TShiftState; X, Y: Integer);
  37.     procedure Image3MouseDown(Sender: TObject; Button: TMouseButton;
  38.       Shift: TShiftState; X, Y: Integer);
  39.     procedure Image3MouseUp(Sender: TObject; Button: TMouseButton;
  40.       Shift: TShiftState; X, Y: Integer);
  41.     procedure Image4Click(Sender: TObject);
  42.     procedure ComboBox1Change(Sender: TObject);
  43.     procedure BitBtn1Click(Sender: TObject);
  44.     procedure FormCreate(Sender: TObject);
  45.   private
  46.     { Private declarations }
  47.   public
  48.     { Public declarations }
  49.   end;
  50.  
  51. var
  52.   Form1: TForm1;
  53.   i:integer;
  54.   macro,name,s:string;
  55.   cmd:array[0..255] of char;
  56. implementation
  57.  
  58. {$R *.DFM}
  59.  
  60. procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  61.   Shift: TShiftState; X, Y: Integer);
  62. begin
  63. IMAGE1.VISIBLE:=FALSE;
  64. end;
  65.  
  66. procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  67.   Shift: TShiftState; X, Y: Integer);
  68. begin
  69. IMAGE1.VISIBLE:=TRUE;
  70. dr.visible:=true;
  71. height:=455;
  72. end;
  73.  
  74. procedure TForm1.Image3MouseDown(Sender: TObject; Button: TMouseButton;
  75.   Shift: TShiftState; X, Y: Integer);
  76. begin
  77. image3.visible:=false;
  78. end;
  79.  
  80. procedure TForm1.Image3MouseUp(Sender: TObject; Button: TMouseButton;
  81.   Shift: TShiftState; X, Y: Integer);
  82. var cmd:array[0..255] of char;
  83. begin
  84. image3.visible:=true;
  85. strpcopy(cmd,s+'\'+flb2.items[0]);
  86. winexec(cmd,SW_ShowNormal);
  87. end;
  88.  
  89. procedure TForm1.Image4Click(Sender: TObject);
  90. begin
  91. close;
  92. end;
  93.  
  94. procedure TForm1.ComboBox1Change(Sender: TObject);
  95. begin
  96. {For i:=0 to combobox1.items.count-1 do
  97. if combobox1.selected[i] then s:=items[i];}
  98. s:=combobox1.text;
  99. s:='\games\'+s;
  100. flb1.directory:=s;
  101. flb2.directory:=s;
  102. flb3.directory:=s;
  103. if flb1.items.count-1<0 then
  104.    image5.picture.loadfromfile('\ps.bmp')
  105.    else
  106.    image5.picture.loadfromfile(s+'\'+flb1.items[0]);
  107. end;
  108.  
  109. procedure TForm1.BitBtn1Click(Sender: TObject);
  110. begin
  111. try
  112.    caption:=dr.text+s;
  113.    mkdir(dr.text+'\games')
  114.    except
  115.    try mkdir(dr.text+s)
  116.        finally {}
  117.    end;
  118. end;
  119.  
  120. if s<>'' then
  121. begin
  122.      for i:=0 to flb3.items.count-1 do
  123.      Begin
  124.      ben.visible:=true;
  125.      ben.progress:=round(i*100/(flb3.items.count-1));
  126.      copyfile(s+'\'+flb3.items[i],dr.text+s);
  127.      End;
  128.      ben.visible:=false;
  129.  
  130.      begin
  131.      Name := 'Games';
  132.      Macro := Format('[CreateGroup(%s)]', [Name]) + #13#10;
  133.      StrPCopy (Cmd, Macro);
  134.      DDEClient.OpenLink;
  135.      if not DDEClient.ExecuteMacro(Cmd, False) then
  136.      MessageDlg('Unable to create group.', mtInformation, [mbOK], 0);
  137.      Macro := Format('[Additem(%s)]', [s+'\'+flb2.items[0]+','+combobox1.text+','+s+'\'+flb2.items[0]])+ #13#10;
  138.      StrPCopy (Cmd, Macro);
  139.      if not DDEClient.ExecuteMacro(Cmd, False) then
  140.         MessageDlg('Unable to Add Item.', mtInformation, [mbOK], 0);
  141.      DDEClient.CloseLink;
  142.      end;
  143. height:=397;
  144. end;
  145.  
  146.  
  147. end;
  148.  
  149. procedure TForm1.FormCreate(Sender: TObject);
  150. begin
  151. flb2.directory:='\games';
  152. end;
  153.  
  154. end.
  155.